Mini Challenge wer: Vorhersage Abstimmungen Mai

#Bibliotheken importieren

library(tidymodels)

Warning: Paket ‘tidymodels’ wurde unter R Version 4.1.3 erstellt
-- Attaching packages ------------------------------------------------------------------------------------------------- tidymodels 0.2.0 --
v broom        0.8.0     v recipes      0.2.0
v dials        0.1.1     v rsample      0.1.1
v dplyr        1.0.8     v tibble       3.1.6
v ggplot2      3.3.6     v tidyr        1.2.0
v infer        1.0.0     v tune         0.2.0
v modeldata    0.1.1     v workflows    0.2.6
v parsnip      0.2.1     v workflowsets 0.2.1
v purrr        0.3.4     v yardstick    0.0.9
Warning: Paket ‘broom’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘dials’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘scales’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘ggplot2’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘infer’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘modeldata’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘parsnip’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘recipes’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘rsample’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘tune’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘workflows’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘workflowsets’ wurde unter R Version 4.1.3 erstellt
Warning: Paket ‘yardstick’ wurde unter R Version 4.1.3 erstellt
-- Conflicts ---------------------------------------------------------------------------------------------------- tidymodels_conflicts() --
x purrr::discard() masks scales::discard()
x dplyr::filter()  masks stats::filter()
x dplyr::lag()     masks stats::lag()
x recipes::step()  masks stats::step()
* Dig deeper into tidy modeling with R at https://www.tmwr.org

library(tidyverse)

Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
-- Attaching packages -------------------------------------------------------------------------------------------------- tidyverse 1.3.1 --
v readr   2.1.2     v forcats 0.5.1
v stringr 1.4.0     
-- Conflicts ----------------------------------------------------------------------------------------------------- tidyverse_conflicts() --
x readr::col_factor() masks scales::col_factor()
x purrr::discard()    masks scales::discard()
x dplyr::filter()     masks stats::filter()
x stringr::fixed()    masks recipes::fixed()
x dplyr::lag()        masks stats::lag()
x readr::spec()       masks yardstick::spec()

library(plotly)

Warning: Paket ‘plotly’ wurde unter R Version 4.1.3 erstellt
Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attache Paket: ‘plotly’

Das folgende Objekt ist maskiert ‘package:ggplot2’:

    last_plot

Das folgende Objekt ist maskiert ‘package:stats’:

    filter

Das folgende Objekt ist maskiert ‘package:graphics’:

    layout

library(esquisse)

Warning: Paket ‘esquisse’ wurde unter R Version 4.1.3 erstellt

library(highcharter)

Warning: Paket ‘highcharter’ wurde unter R Version 4.1.3 erstellt
Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 

library(formattable)

Warning: Paket ‘formattable’ wurde unter R Version 4.1.3 erstellt

Attache Paket: ‘formattable’

Das folgende Objekt ist maskiert ‘package:plotly’:

    style

Die folgenden Objekte sind maskiert von ‘package:scales’:

    comma, percent, scientific

library(rpart)

Attache Paket: ‘rpart’

Das folgende Objekt ist maskiert ‘package:dials’:

    prune

library(rpart.plot)

Warning: Paket ‘rpart.plot’ wurde unter R Version 4.1.3 erstellt

#Datensatz einlesen
df_original <- read.csv("https://swissvotes.ch/page/dataset/swissvotes_dataset.csv", header=TRUE, sep=";", na = c("NA", "."))

```r
parteien <- c(\.svp\, \.fdp\, \.sps\, \.cvp\, \.gps\, \.mitte\)

#Daten selektieren
df <- df %>%
  select(datum, titel_off_d, anzahl, rechtsform, d1e1:br.pos, bv.pos:srnein, unter.quorum, unter_g, unter_u, ends_with(parteien), ja.lager:neutral.summe, volk:ktjaproz) %>%
  mutate(datum = as.Date(datum, \%d.%m.%Y\)) %>% 
  mutate(p.cvp = ifelse(p.cvp == 9999, p.mitte, p.cvp))%>% #CVP wurde zu Mitte -> fehlende Daten cvp durch Daten der Mitte ergänzt
  mutate(w.cvp = ifelse(w.cvp == 0, w.mitte, w.cvp))%>%  #CVP wurde zu Mitte -> fehlende Daten cvp durch Daten der Mitte ergänzt
  rename(p.cvp_mitte = p.cvp, w.cvp_mitte = w.cvp)  %>% 
  select(-c(p.mitte, w.mitte))

#Themen vom Mai 
mai <- df %>%
  filter(datum > as.Date(\01.05.2022\, \%d.%m.%Y\ )) %>%
  select(d1e1:d3e3)

<!-- rnb-source-end -->

<!-- rnb-chunk-end -->


<!-- rnb-text-begin -->




<!-- rnb-text-end -->


<!-- rnb-chunk-begin -->


<!-- rnb-source-begin eyJkYXRhIjoiYGBgclxuI1ZhcmlhYmxlbiBkZWZpbmllcmVuIHVtIG5hY2hoZXIgbWVocmVyZSBTcGFsdGVuIGdsZWljaHplaXRpZyB6dSBtdXRpZXJlblxucG9zaXRpb25lbiAgPC0gZGYgJT4lXG4gIHNlbGVjdChlbmRzX3dpdGgoXCIucG9zXCIpfHN0YXJ0c193aXRoKFwicC5cIil8c3RhcnRzX3dpdGgoXCJwZGV2XCIpKSBcblxuaGF1cHR0aGVtYSA8LSBkZiAlPiVcbiAgc2VsZWN0KGQxZTEsIGQyZTEgLGQzZTEpXG5cbnVudGVydGhlbWEgPC0gZGYgJT4lXG4gIHNlbGVjdChkMWUyLCBkMmUyICxkM2UyKVxuXG5kYXRlbiA8LSBkZiAlPiVcbiAgc2VsZWN0KGRhdHVtLCBzdGFydHNfd2l0aChcImRhdC5cIikpXG5cbnJlc3VsdGF0ZSA8LSBkZiAlPiVcbiAgc2VsZWN0KGVuZHNfd2l0aChcImFubmFobWVcIil8IHZvbGsgfCBzdGFuZClcblxuI2JlcmVpbmlndGVuIERhdGVuc2F0eiBlcnN0ZWxsZW4gKFZhcmlhYmxlbiBiZW5lbm5lbiwgU3BhbHRlbiB1bWJlbmVubmVuKVxuZGZfY2xlYW4gPC0gZGYgJT4lXG4gIG11dGF0ZShyZWNodHNmb3JtID0gZmFjdG9yKGNhc2Vfd2hlbihcbiAgICByZWNodHNmb3JtID09IDEgfiBcIk9ibGlnYXRvcmlzY2hlcyBSZWZlcmVuZHVtXCIsICNPUlxuICAgIHJlY2h0c2Zvcm0gPT0gMiB+IFwiRmFrdWx0YXRpdmVzIFJlZmVyZW5kdW1cIiwgI0ZSXG4gICAgcmVjaHRzZm9ybSA9PSAzIH4gXCJWb2xrc2luaXRpYXRpdmVcIiwgI1ZJXG4gICAgcmVjaHRzZm9ybSA9PSA0IH4gXCJHZWdlbmVudHd1cmYgenUgVm9sa3Npbml0aWF0aXZlXCIsICNHVlxuICAgIHJlY2h0c2Zvcm0gPT0gNSB+IFwiU3RpY2hmcmFnZVwiKSkpJT4lICAjU1xuICBtdXRhdGUoYWNyb3NzKG5hbWVzKHBvc2l0aW9uZW4pLCBcbiAgICAgICAgICAgfiBmYWN0b3IoY2FzZV93aGVuKC4gPT0gMSB+IFwiQmVmw7xyd29ydGVuZFwiLFxuICAgIC49PSAyIH5cIkFibGVobmVuZFwiLFxuICAgIC49PSAzIH5cIktlaW5lXCIsXG4gICAgLj09IDQgflwiTGVlcmUgQWJnYWJlXCIsXG4gICAgLj09IDUgflwiU3RpbW1mcmVpZ2FiZVwiLFxuICAgIC49PSA4IH5cIlZvcnp1ZyBmw7xyIGRlbiBHZWdlbmVudHd1cmZcIixcbiAgICAuPT0gOSB+XCJWb3J6dWcgZsO8ciBWb2xrc2luaXRpYXRpdmVcIixcbiAgICAuID09IDY2IH5cImtlaW5lXCIsXG4gICAgLiA9PSA5OTk5IH5cIlBhcnRlaSBleC4gbmljaHRcIiwpKSkpICU+JVxuICBtdXRhdGUoYWNyb3NzKG5hbWVzKHJlc3VsdGF0ZSksIFxuICAgICAgICAgICAgICAgIH4gZmFjdG9yKGNhc2Vfd2hlbiguID09IDAgflwiYWJnZWxlaG50XCIsIFxuICAgICAgICAgICAgICAgIC49PSAxIH4gXCJhbmdlbm9tbWVuXCIsIFxuICAgICAgICAgICAgICAgIC49PSAzIH4gXCJTdMOkbmRlbWVociBuaWNodCBuw7Z0aWdcIiwgXG4gICAgICAgICAgICAgICAgLj09IDggfiBcIkdlZ2VuZW50d3VyZiBhbmdlbm9tbWVuXCIsIFxuICAgICAgICAgICAgICAgIC49PSA5IH4gXCJWb2xrc2luaXRpYXRpdmUgYW5nZW5vbW1lblwiICkpKSkgXG5cblxuXG5kYXRhX21haSA8LSBkZl9jbGVhbiAlPiVcbiAgZmlsdGVyKGRhdHVtID4gYXMuRGF0ZShcIjAxLjA1LjIwMjJcIiwgXCIlZC4lbS4lWVwiICkpIFxuXG5gYGAifQ== -->

```r
#Variablen definieren um nachher mehrere Spalten gleichzeitig zu mutieren
positionen  <- df %>%
  select(ends_with(".pos")|starts_with("p.")|starts_with("pdev")) 

hauptthema <- df %>%
  select(d1e1, d2e1 ,d3e1)

unterthema <- df %>%
  select(d1e2, d2e2 ,d3e2)

daten <- df %>%
  select(datum, starts_with("dat."))

resultate <- df %>%
  select(ends_with("annahme")| volk | stand)

#bereinigten Datensatz erstellen (Variablen benennen, Spalten umbenennen)
df_clean <- df %>%
  mutate(rechtsform = factor(case_when(
    rechtsform == 1 ~ "Obligatorisches Referendum", #OR
    rechtsform == 2 ~ "Fakultatives Referendum", #FR
    rechtsform == 3 ~ "Volksinitiative", #VI
    rechtsform == 4 ~ "Gegenentwurf zu Volksinitiative", #GV
    rechtsform == 5 ~ "Stichfrage")))%>%  #S
  mutate(across(names(positionen), 
           ~ factor(case_when(. == 1 ~ "Befürwortend",
    .== 2 ~"Ablehnend",
    .== 3 ~"Keine",
    .== 4 ~"Leere Abgabe",
    .== 5 ~"Stimmfreigabe",
    .== 8 ~"Vorzug für den Gegenentwurf",
    .== 9 ~"Vorzug für Volksinitiative",
    . == 66 ~"keine",
    . == 9999 ~"Partei ex. nicht",)))) %>%
  mutate(across(names(resultate), 
                ~ factor(case_when(. == 0 ~"abgelehnt", 
                .== 1 ~ "angenommen", 
                .== 3 ~ "Ständemehr nicht nötig", 
                .== 8 ~ "Gegenentwurf angenommen", 
                .== 9 ~ "Volksinitiative angenommen" )))) 



data_mai <- df_clean %>%
  filter(datum > as.Date("01.05.2022", "%d.%m.%Y" )) 

n_FR_angenommen / n_angenommen

       n 
0.368254 

#Visualisierung mittels Boxplot
Unterschriften <- df_clean %>% filter(rechtsform == "Fakultatives Referendum", !is.na(annahme)) %>% ggplot(aes(annahme, unter_g)) + geom_boxplot()

ggplotly(Unterschriften)

jalager <- df_clean %>% filter( !is.na(annahme)) %>% ggplot(aes(annahme, ja.lager)) + geom_boxplot()

ggplotly(jalager)

Warning: Removed 34 rows containing non-finite values (stat_boxplot).

ggplot(df_clean, aes(annahme, ja.lager)) + geom_jitter()

Warning: Removed 34 rows containing missing values (geom_point).

vorhersagen <- vorhersagen %>% 
  select(-c(nr.pos, sr.pos, bv.pos)) %>% 
  rename(Titel = titel_kurz_d)

Error in `select()`:
! Can't subset columns that don't exist.
x Column `nr.pos` doesn't exist.
Backtrace:
  1. vorhersagen %>% select(-c(nr.pos, sr.pos, bv.pos)) %>% ...
  4. dplyr:::select.data.frame(., -c(nr.pos, sr.pos, bv.pos))
  7. tidyselect::eval_select(expr(c(...)), .data)
  8. tidyselect:::eval_select_impl(...)
 17. tidyselect:::vars_select_eval(...)
     ...
 27. tidyselect:::chr_as_locations(x, vars, call = call)
 28. vctrs::vec_as_location(x, n = length(vars), names = vars)
 29. vctrs `<fn>`()
 30. vctrs:::stop_subscript_oob(...)
 31. vctrs:::stop_subscript(...)

#Entscheidungsbaum nur mit rpart (da Baum sonst nicht geplottet werden konnte)
model <- rpart(annahme ~ ., data = data_baum, method = 'class',control=rpart.control(minsplit = 12, minbucket = 10, cp=0.009))

predict(model, data_mai_baum, type = 'class')

         1          2          3 
 abgelehnt angenommen angenommen 
Levels: abgelehnt angenommen

predict(model, organspende, type = 'class')

         1 
angenommen 
Levels: abgelehnt angenommen

predict(model, Frontex, type = 'class')

         1 
angenommen 
Levels: abgelehnt angenommen

predict(model, filmgesetz, type = 'class')

        1 
abgelehnt 
Levels: abgelehnt angenommen

rpart.plot(model, extra = "auto")

NA
NA
NA

#Visualisierung Verteilung der Rechtsformen
ggplot(df_clean, aes(x = rechtsform)) +
  geom_bar()

NA
NA

mean(df_clean$rechtsform)

Warning in mean.default(df_clean$rechtsform) :
  Argument ist weder numerisch noch boolesch: gebe NA zurück

[1] NA